home *** CD-ROM | disk | FTP | other *** search
/ Aminet 23 / Aminet 23 (1998)(GTI - Schatztruhe)[!][Feb 1998].iso / Aminet / dev / lang / nrcobol_1b.lha / NRCOBOL1b / COBFILES / INADS.COB < prev    next >
Text File  |  1997-06-25  |  10KB  |  257 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID.   INADS.
  3.       *PROGRAM DISCRIPTION.
  4.       *
  5.       *program to create data for index files paper.nam and advert.typ
  6.       *
  7.       *AUTHOR.        cHArRiOTt.
  8.       *INSTALLATION.
  9.       *DATE-WRITTEN.  24th AUG 89.
  10.       *DATE-COMPILLED.
  11.       *SECURITY.
  12.        ENVIRONMENT DIVISION.
  13.  
  14.        CONFIGURATION SECTION.
  15.        SOURCE-COMPUTER.   AMSTRAD 1512.
  16.        OBJECT-COMPUTER.
  17.        INPUT-OUTPUT SECTION. 
  18.        FILE-CONTROL.
  19.  
  20.             SELECT           IN-NEWSPAPER-NAME
  21.             ASSIGN TO        DISK
  22.             ORGANIZATION IS  INDEXED
  23.             ACCESS MODE  IS  RANDOM
  24.             RECORD KEY   IS  ER-PAPER-CODE
  25.             FILE STATUS  IS  WS-PAPER-FILE-STATUS.
  26.  
  27.             SELECT           IN-ADVERT-TYPE
  28.             ASSIGN TO        DISK
  29.             ORGANIZATION IS  INDEXED
  30.             ACCESS MODE  IS  RANDOM
  31.             RECORD KEY   IS  ER-IN-AD-CODE
  32.             FILE STATUS  IS  WS-AD-TYPE-STATUS.
  33.  
  34.       *
  35.        DATA DIVISION.
  36.        FILE SECTION.
  37.        FD IN-NEWSPAPER-NAME
  38.             LABEL RECORD IS  STANDARD
  39.             VALUE OF FILE-ID IS "PAPER.NAM".
  40.        01 ER-NEWSPAPER-NAME.
  41.            03 ER-PAPER-CODE         PIC X(3).
  42.            03 ER-PAPER-NAME         PIC X(25).
  43.       *
  44.        FD IN-ADVERT-TYPE
  45.             LABEL RECORD IS  STANDARD
  46.             VALUE OF FILE-ID IS "ADVERT.TYP".
  47.        01 ER-ADVERT-TYPE.
  48.            03 ER-IN-AD-CODE         PIC 9(3).
  49.            03 ER-TYPE-OF-AD         PIC X(20).
  50.            03 ER-PRICE-PER-LINE     PIC 9V99.
  51.       *
  52.       **********************************************************
  53.       *
  54.        WORKING-STORAGE SECTION.
  55.        01 WS-NEWSPAPER-NAME.
  56.            03 WS-PAPER-CODE         PIC X(3).
  57.               88 WS-TERMINATE-PAPER VALUE "999".
  58.            03 WS-PAPER-NAME         PIC X(25).
  59.       *
  60.        01 WS-ADVERT-TYPE.
  61.            03 WS-IN-AD-CODE         PIC 9(3).
  62.               88 WS-TEMINATE-ADVERTS VALUE 999.
  63.            03 WS-TYPE-OF-AD         PIC X(20).
  64.            03 WS-PRICE-PER-LINE     PIC 9V99.
  65.       *
  66.        01 WS-REAL-DATE.
  67.            03 WS-REAL-YEAR          PIC XX.
  68.            03 WS-REAL-MONTH         PIC XX.
  69.            03 WS-REAL-DAY           PIC XX.
  70.        01 WS-TEMP-DATE.
  71.            03 WS-TEMP-DAY           PIC XX.
  72.            03 FILLER                PIC X  VALUE "/".
  73.            03 WS-TEMP-MONTH         PIC XX.
  74.            03 FILLER                PIC X  VALUE "/".
  75.            03 WS-TEMP-YEAR          PIC XX.
  76.       *
  77.        01 WS-COUNTERS.
  78.            03 WS-PAGE-COUNTER           PIC 99.
  79.            03 WS-LINE-COUNTER           PIC 99.
  80.            03 ws-file-counter           pic 999 value 0.
  81.            
  82.        01 WS-END-ENTRY              PIC X   VALUE " ".
  83.        01 WS-STOP-RUN-FLAG          PIC X   VALUE " ".
  84.        01 WS-END-FILE-FLAG          PIC X   VALUE " ".
  85.        01 WS-ABORT-READ-FLAG        PIC X   VALUE " ".
  86.        01 WS-PAPER-FILE-STATUS      PIC XX  VALUE "00".
  87.        01 WS-AD-TYPE-STATUS         PIC XX  VALUE "00".
  88.        01 WS-RESPONCE               PIC X.
  89.            88  WS-RESPONCE-Q        VALUE  "Q" "q".
  90.            88  WS-RESPONCE-A        VALUE  "A" "a".
  91.            88  WS-RESPONCE-P        VALUE  "P" "p".
  92.            88  WS-RESPONCE-YN       VALUE  "Y" "N"
  93.                                            "y" "n".
  94.            88  WS-RESPONCE-Y        VALUE  "Y" "y".
  95.            88  WS-RESPONCE-N        VALUE  "N" "n".
  96.       *
  97.       **********************************************************
  98.       *
  99.        SCREEN SECTION.
  100.        01 BLANK-SCREEN.
  101.            03 BLANK SCREEN.
  102.        01 PROG-DISCRIPTION.
  103.            03 LINE 1 COLUMN 5      VALUE 
  104.            "A PROGRAM TO PRODUCE DATA FOR CLASSIFIED ADVERTISING INCOME 
  105.       -    " REPORT".
  106.        01 DIS-PROG-TITLE.
  107.            03 LINE 3 COLUMN 1   PIC X(8) FROM WS-TEMP-DATE.
  108.            03 LINE 3 COLUMN 22     HIGHLIGHT VALUE
  109.                                "DATA FOR ADVERTISING INCOME REPORT".
  110.            03 LINE 3 COLUMN 65     VALUE "PAGE ".
  111.            03 LINE 3 COLUMN 70  PIC X(8) FROM WS-PAGE-COUNTER.
  112.        01 PAPER-REC.
  113.            03 LINE 6  COLUMN 5  VALUE     
  114.                    "NEWSPAPER DATABASE,   Please enter as directed".
  115.            03 LINE 10 COLUMN 5  VALUE  "NEWSPAPER NAME : ".
  116.            03 LINE 10 COLUMN 22 PIC X(25) TO WS-PAPER-NAME.
  117.            03 LINE 12 column 5  value  "NEWSPAPER CODE : ".
  118.            03 LINE 12 COLUMN 22 PIC X(3)  USING WS-PAPER-CODE.
  119.            03 LINE 18 COLUMN 5  VALUE  "NEWSPAPER CODE '999' TO EXIT".
  120.        01 ADVERTS-REC.
  121.            03 LINE 6  COLUMN 5  VALUE     
  122.                    "ADVERTS DATABASE      Please enter as directed".
  123.            03 LINE 10 COLUMN 5  VALUE  "ADVERT CODE (numeric)  : ".
  124.            03 LINE 10 COLUMN 30 PIC 9(3)  TO WS-IN-AD-CODE.
  125.            03 LINE 12 COLUMN 5  VALUE  "TYPE OF ADVERT (20 MAX): ".
  126.            03 LINE 12 COLUMN 30 PIC X(20) TO WS-TYPE-OF-AD.
  127.            03 LINE 14 COLUMN 5  VALUE  "COST OF ADVERT (9.99)  : ".
  128.            03 LINE 14 COLUMN 30 PIC 9V99  TO WS-PRICE-PER-LINE.
  129.            03 LINE 18 COLUMN 5  VALUE  "ADVERT CODE '999' TO EXIT".
  130.        01 BAD-KEY.
  131.            03 LINE 18 COLUMN 5  VALUE "BAD KEY FIELD PLEASE TRY AGAIN".
  132.  
  133.        01 MENU.
  134.            03 LINE 8  COLUMN 33    UNDERLINE  VALUE "MENU".
  135.            03 LINE 13 COLUMN 22 VALUE "PRESS 'A' to create ADVERT.TYP".
  136.            03 LINE 15 COLUMN 22 VALUE "      'P' to create PAPER.NAME".
  137.            03 LINE 17 COLUMN 22 VALUE "      'Q' to quit     MENU   ".
  138.            03 LINE 20 COLUMN 19 VALUE "NOW WHAT? ".
  139.        01 MENU-INPUT.
  140.            03 LINE 20 COLUMN 29    PIC X TO WS-RESPONCE AUTO.
  141.        01 TASK-RUNING.
  142.            03 LINE 23 COLUMN 5     HIGHLIGHT VALUE 
  143.                                             "REPORT NOW BEING PRINTED". 
  144.        01 PROG-FINISH.
  145.            03 LINE 25 COLUMN 1     BLANK LINE.
  146.            03 LINE 25 COLUMN 5     VALUE "TASK COMPLEATE".
  147.        01 ANY-KEY.
  148.            03 LINE 25 COLUMN 33    PIC X TO WS-RESPONCE AUTO.
  149.        01 RESPONCE-LINE.
  150.            03 LINE 25 COLUMN 5     VALUE 
  151.               "PRINT ANY KEY TO CONTINUE > ".
  152.       * 
  153.        01 ERROR-MESSAGES.
  154.            03 LINE 23 COLUMN 5  VALUE 
  155.                      "FILE WOULD NOT OPEN :ADS:PAP:TYP:PRT:".
  156.            03 LINE 24 COLUMN 5  VALUE 
  157.                      "STATUS ERROR CODES  :   :   :   :   :".
  158.            03 LINE 24 COLUMN 30  HIGHLIGHT  PIC XX
  159.               FROM WS-PAPER-FILE-STATUS.
  160.            03 LINE 24 COLUMN 34  HIGHLIGHT  PIC XX
  161.               FROM WS-AD-TYPE-STATUS.           
  162.       *
  163.       **********************************************************
  164.       *
  165.        PROCEDURE DIVISION.
  166.       *
  167.        0000-MAIN.
  168.            OPEN OUTPUT  IN-NEWSPAPER-NAME.
  169.            OPEN OUTPUT  IN-ADVERT-TYPE.
  170.                 IF WS-PAPER-FILE-STATUS = "00"  AND
  171.                    WS-AD-TYPE-STATUS    = "00"
  172.                          PERFORM 1000-DISPLAY 
  173.                                  UNTIL WS-STOP-RUN-FLAG = "S"
  174.                    ELSE
  175.                          DISPLAY ERROR-MESSAGES.
  176.            CLOSE IN-NEWSPAPER-NAME.
  177.            CLOSE IN-ADVERT-TYPE.
  178.            STOP RUN.
  179.       *
  180.       **********************************************************
  181.       *
  182.        1000-DISPLAY.
  183.            ACCEPT WS-REAL-DATE FROM DATE.
  184.            MOVE WS-REAL-DAY   TO WS-TEMP-DAY.
  185.            MOVE WS-REAL-MONTH TO WS-TEMP-MONTH.
  186.            MOVE WS-REAL-YEAR  TO WS-TEMP-YEAR.
  187.            MOVE 1 TO WS-PAGE-COUNTER.
  188.            MOVE SPACE TO WS-END-ENTRY.
  189.            PERFORM 1005-NEWSCREEN.
  190.  
  191.            DISPLAY MENU.
  192.            ACCEPT  MENU-INPUT.
  193.            IF WS-RESPONCE-Q
  194.                  MOVE "S" TO WS-STOP-RUN-FLAG
  195.                  DISPLAY PROG-FINISH
  196.              ELSE
  197.              IF WS-RESPONCE-A
  198.                    PERFORM 1100-ADVERTS-REC
  199.                                 UNTIL WS-END-ENTRY = "S"
  200.                ELSE
  201.                IF WS-RESPONCE-P
  202.                      PERFORM 1200-PAPER-REC   
  203.                                   UNTIL WS-END-ENTRY = "S".
  204.       *
  205.        1005-NEWSCREEN.
  206.            DISPLAY BLANK-SCREEN.
  207.            DISPLAY PROG-DISCRIPTION.
  208.            DISPLAY DIS-PROG-TITLE. 
  209.  
  210.       *
  211.       **********************************************************
  212.       *
  213.        1100-ADVERTS-REC. 
  214.            PERFORM 1005-NEWSCREEN.
  215.            PERFORM 1105-BLANK-ADVERTS.
  216.            DISPLAY ADVERTS-REC.
  217.            ACCEPT  ADVERTS-REC.
  218.            IF NOT WS-TEMINATE-ADVERTS
  219.               WRITE ER-ADVERT-TYPE FROM WS-ADVERT-TYPE
  220.               INVALID KEY DISPLAY BAD-KEY
  221.                           DISPLAY RESPONCE-LINE
  222.                           ACCEPT  ANY-KEY
  223.            ELSE
  224.               MOVE "S" TO WS-END-ENTRY.
  225.             
  226.       *
  227.        1105-BLANK-ADVERTS.
  228.            MOVE SPACES TO WS-TYPE-OF-AD.
  229.            MOVE ZERO   TO WS-IN-AD-CODE.
  230.            MOVE ZERO   TO WS-PRICE-PER-LINE. 
  231.       *
  232.       **********************************************************
  233.       *
  234.        1200-PAPER-REC. 
  235.            PERFORM 1005-NEWSCREEN.
  236.            PERFORM 1205-BLANK-PAPER.
  237.            DISPLAY PAPER-REC.
  238.            ACCEPT  PAPER-REC.
  239.            IF NOT WS-TERMINATE-PAPER
  240.               WRITE ER-NEWSPAPER-NAME FROM WS-NEWSPAPER-NAME
  241.               INVALID KEY DISPLAY BAD-KEY
  242.                           DISPLAY RESPONCE-LINE
  243.                           ACCEPT  ANY-KEY
  244.            ELSE
  245.               MOVE "S" TO WS-END-ENTRY.
  246.       *
  247.        1205-BLANK-PAPER.
  248.            MOVE SPACES TO WS-NEWSPAPER-NAME.
  249.            add 37 to ws-file-counter.
  250.            move ws-file-counter to WS-PAPER-CODE.
  251.       *
  252.       **********************************************************
  253.       
  254.  
  255.  
  256.  
  257.